perm filename SMX[MSS,LCS] blob
sn#096373 filedate 1974-04-09 generic text, type T, neo UTF8
00010 SUBROUTINE SMOOTH(JQ)
00020 COMMON/ED/KX,NEXT,NN,NX,NY,J/LL/L
00040 COMMON /RC/MCLEF(200),IST(4000)
00060 COMMON /RZ/RSZ,IPLT,RJB,CENTR
00080 COMMON /FL/IC,NJ,NQ,RZ,IXRX,XGP,RXGP
00100 DIMENSION BUF2(700)
00105 COMMON/NFF/NE(513)
00110 DATA INC/4/
00200 COMMON X(100),Y(100),N,X1(512),Y1(512),S(100),K
00220 NOFIL=-1
00230 100 JY=2
00240 8 KX=0
00250 KZ=0
00300 CALL DPYSET(3,BUF2,700)
00310 7 JX=J
00312 KX=KZ
00315 CALL SETPOG(3)
00400 DO 1 K=JY,J
00600 CALL UNPACK(K,JA,JB,MCLEF)
00602 IF(L.GE.100000000.AND.K.GT.JY)GO TO 6
00603 C JUMP WHEN INVIS. VECT.
00605 KX=KX+1
00610 X(KX)=(JA+RJB)*RSZ
00620 1 Y(KX)=(JB+CENTR)*RSZ
00630 9 X(KX+1)=999.
01300 4 N=KX
01900 CALL SS
01950 IF(JQ.NE.' ')CALL HYDPOG(1)
02050 RZ=RSZ
02060 IF(IXRX)RZ=RZ*1.7
02070 RSZ=1.0
02100 CALL LINES(X1(1),Y1(1),3)
02110 KZ=0
02200 DO 5 K=2,512,INC
02210 KZ=KZ+1
02300 NE(KZ)=0
02310 X1(KZ)=X1(K)
02320 Y1(KZ)=Y1(K)
02350 5 CALL LINES(X1(K),Y1(K),2)
02355 NE(KZ+1)=KA
02360 KA=KZ+2
02370 NE(1)=KZ
02400 CALL DPYOUT(3)
02410 RSZ=RZ
02900 IF(JX.NE.J)GO TO 7
02910 CALL SETPOG(1)
02920 IF(NOFIL)RETURN
02950 CALL FILLQ(X1,Y1,NE)
03000 RETURN
05200 6 JY=K
05300 JX=JY
05500 END
05600
05700 SUBROUTINE EDTYP(K,X,JJJ)
05800 TYPE 57
05900 ACCEPT 1,K,X
06000 IF(K.NE.' ')JJJ=0
06100 IF(K.EQ.':'.OR.JJJ)GO TO 2
06200 C TYPE "A" OR ":" TO ALTER
06300 IF(K.NE.'G')RETURN
06400 JJJ=-1
06500 2 K='A'
06600 RETURN
06700 57 FORMAT(' TYPE D, A, I OR X ',$)
06800 1 FORMAT(A1,2F)
06900 END
07000
07100 SUBROUTINE ITYP
07200 COMMON/ED/K,NEXT,NN,NX,NY,J
07300 TYPE 1,NN,NX,NY
07400 RETURN
07500 1 FORMAT(I4,')',2I6)
07600 END
07700
07800 SUBROUTINE FILLQ(Q,R,N)
07900 DIMENSION Q(1),R(1),N(1)
07910 COMMON /FL/IC,NJ,NQ,RZ,IXRX,XGP,RXGP
07955 COMMON /RZ/RSZ,IPLT,RJB,CENTR
08000 M=6
08100 IF(IPLT)M=1
08200 1 RZ=RSZ
08250 RSZ=1.0
08300 IF(IXRX)RZ=RZ*1.7
08400 CALL FILLER(Q,R,N,M)
08500 RSZ=RZ
08600 END